home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / libs / anivga12 / dateien.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-11  |  46KB  |  1,357 lines
  1. {$UNDEF test}
  2. {$IFDEF test}
  3.   PROGRAM dateien;
  4.   {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V-,X-}
  5.   {$M 32768,0,655360}
  6. {$ELSE}
  7.   unit dateien;
  8.   {$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S+,V-,X-}
  9.   {$M 32768,150000,655360}
  10.  
  11. {Zweck    : Stellt eine komfortable Dateiauswahlschachtel für die    }
  12. {           Auswahl einzelner oder mehrerer Dateien zur Verfügung    }
  13. {Autor    : Kai Rohrbacher    }
  14. {Sprache  : TurboPascal 6.0   }
  15. {Datum    : 17.09.1992        }
  16. {Anmerkung: Arbeitet dynamisch und mit allen Textmodi                }
  17.  
  18. interface
  19. {$ENDIF}
  20. USES crt,dos,eingaben;
  21.  
  22. type TArt=(Laufwerk,Verzeichnis,Datei);
  23.      TPath =String[67];
  24.      TName =String[8];
  25.      TPunkt=CHAR;
  26.      TExten=String[3];
  27.      TAlles=STRING[8+1+3];
  28.      TSize =LONGINT;
  29.      TDate =LONGINT;
  30.      PDateiName=^Dateiname;
  31.      Dateiname=
  32.        RECORD
  33.         next:PDateiName;
  34.         art:TArt;
  35.         size:TSize;
  36.         date:TDate;
  37.         Vorname:TName; Punkt:TPunkt; Nachname:TExten;
  38.         ganz:TAlles;
  39.        END;
  40.  
  41. TYPE VideoMem=ARRAY[0..32766] OF WORD;
  42. VAR ScreenX,ScreenY:BYTE; {enthalten aktuelle Auflösung, z.B. 80 und 43}
  43.     Basis:^VideoMem;      {zeigt auf Pos. (0,0) der akt. Textseite}
  44.  
  45. VAR  Laufwerke:String;  {Laufwerke im System, wird noch ergänzt!}
  46.  
  47. {$IFNDEF test}
  48.  PROCEDURE Auswahl(x,y,MaxZeilen:BYTE; Header:STRING;
  49.                    list:PDateiname; listlen:WORD;
  50.                    nur_eins:BOOLEAN; VAR last,sel:PDateiname;
  51.                    VAR CursSelected:BOOLEAN);
  52.  PROCEDURE MakeFileList(VAR p:TPath; typ:STRING;
  53.                         VAR list:PDateiName; VAR listlen:WORD;
  54.                         VAR error:BOOLEAN);
  55.  FUNCTION ChooseSingleFile(xpos,ypos,max_zeilen:BYTE;
  56.                            Pf:TPath; typ:STRING; VAR error:BOOLEAN):TPath;
  57.  FUNCTION ChooseMultipleFiles(xpos,ypos,max_zeilen:BYTE;
  58.                               VAR Pfad:TPath; typ:STRING;
  59.                               VAR error:BOOLEAN):PDateiname;
  60.  PROCEDURE StripBlanks(VAR s:TAlles);
  61.  PROCEDURE DelList(VAR list:PDateiName);
  62.  FUNCTION UpString(St:String):STRING;
  63.  FUNCTION LoString(St:String):STRING;
  64.  PROCEDURE Rahmen(x1,y1,x2,y2:byte);
  65.  PROCEDURE DetectXYresolution(VAR x,y:BYTE);
  66.  FUNCTION BaseAddress:POINTER;
  67.  PROCEDURE OutCharXY(x,y:BYTE; ch:WORD);
  68.  FUNCTION GetCharXY(x,y:BYTE):WORD;
  69.  PROCEDURE OutStringXY(x,y,attr:BYTE; s:STRING);
  70.  FUNCTION min(x,y:INTEGER):INTEGER;
  71.  FUNCTION max(x,y:INTEGER):INTEGER;
  72.  FUNCTION BIOSreadKey:WORD;
  73.  FUNCTION Festplatten_im_System:String;
  74.  
  75. implementation
  76. {$ENDIF}
  77.  
  78. CONST SelUnsel:InputString='*.*'; {Suchmaske bei "+","-"; Ersatz für "STATIC"}
  79. VAR oldx,oldy,attr:BYTE;
  80.     oldDir:TPath;
  81.  
  82. {---------- Routinen für exotische Bildschirmmodi------------}
  83.  
  84.  PROCEDURE DetectXYResolution(VAR x,y:BYTE); ASSEMBLER;
  85.  { in: - }
  86.  {out: x = Anzahl Spalten des aktuellen Videomodus}
  87.  {     y = dto., Zeilen}
  88.  ASM
  89.   PUSH BP
  90.  
  91.   MOV DL,24
  92.   XOR BH,BH
  93.   MOV AX,$1130
  94.   INT $10
  95.   MOV AH,$F
  96.   INT $10
  97.   INC DL
  98.  
  99.   POP BP
  100.  
  101.   LES DI,x
  102.   MOV AL,AH
  103.   STOSB
  104.   LES DI,y
  105.   MOV AL,DL
  106.   STOSB
  107.  END;
  108.  
  109.  FUNCTION BaseAddress:POINTER; ASSEMBLER;
  110.  {out: Zeiger auf 1.Byte der aktuellen Textseite}
  111.  {rem: Mono-/Farbgrafikadapter, exotische Auflösungen}
  112.  {     und mehrere Bildschirmseiten werden berücksichtigt!}
  113.  ASM
  114.   PUSH DS
  115.   PUSH BP
  116.  
  117.   MOV AH,$F
  118.   INT $10   {danach: BH=Display page }
  119.   MOV AH,3
  120.   INT $10   {danach: DH/DL=Cursor Y/X}
  121.   PUSH DX   {merken!}
  122.  
  123.   MOV AH,2
  124.   XOR DX,DX
  125.   INT $10   {Cursor ist jetzt bei Pos. (0,0)}
  126.  
  127.   MOV AH,8
  128.   INT $10   {Zeichen von dort lesen: AL/AH=ASCII/Attr.}
  129.   PUSH AX   {merken!}
  130.  
  131.   XOR SI,SI
  132.   MOV DS,SI
  133.   MOV SI,$44E
  134.   MOV DI,[SI]  {DI=Pageoffset der aktuellen Seite}
  135.   MOV SI,$B800 {Farbsegment ausprobieren}
  136.   MOV ES,SI    {ES:DI=^Pos(0,0) der akt. Seite, wenn Farbmonitor}
  137.   NEG AX    {Zeichen verändert zurückschreiben}
  138.   STOSW
  139.  
  140.   MOV AH,2
  141.   XOR DX,DX
  142.   INT $10   {Cursor ist jetzt wieder bei Pos. (0,0)}
  143.  
  144.   MOV AH,8
  145.   INT $10   {Zeichen prüflesen: in AL/AH}
  146.   POP CX    {altes Zeichen}
  147.   POP DX    {alte Cursorposition}
  148.   CMP AX,CX {vergleiche Zeichen mit altem}
  149.   PUSHF     {Ergebnis merken}
  150.   PUSH CX   {altes Zeichen wird nochmal gebraucht}
  151.  
  152.   MOV AH,9
  153.   MOV AL,CL
  154.   MOV BL,CH
  155.   MOV CX,1
  156.   INT $10   {altes Zeichen zurück nach Pos(0,0) schreiben}
  157.  
  158.   MOV AH,2
  159.   INT $10   {Cursor ist jetzt wieder an alter Stelle}
  160.  
  161.   XOR SI,SI
  162.   MOV DS,SI
  163.   MOV SI,$44E
  164.   MOV DI,[SI]  {DI=Pageoffset der aktuellen Seite}
  165.   MOV SI,$B800 {Farbsegment}
  166.   MOV ES,SI    {ES:DI=^Pos(0,0) der akt. Seite}
  167.   POP AX       {altes Zeichen zurückschreiben}
  168.   MOV ES:[DI],AX
  169.  
  170.   POPF      {Vergleichsergebnis von vorhin}
  171.  
  172.   POP BP
  173.   POP DS
  174.  
  175.   JE @monochrom
  176.   MOV DX,$B800
  177.   JMP @offset
  178.  @monochrom:
  179.   MOV DX,$B000
  180.  @offset:
  181.   MOV AX,DI
  182.  END;
  183.  
  184.  PROCEDURE OutCharXY(x,y:BYTE; ch:WORD);
  185.  { in: (x,y) = Bildschirmposition für auszugebendes Zeichen}
  186.  {     ch = auszugebendes Zeichen, inklusive Attribut, in  }
  187.  {          der Form "Farbe SHL 8 +Ord(Zeichen)"}
  188.  {     Basis = Zeiger auf Pos. (0,0) des Schirms}
  189.  {     ScreenX = horizontale Auflösung des Bildschirms}
  190.  {     ScreenY = dto., vertikal}
  191.  {rem: Die Cursorposition wurde durch OutCharXY() nicht weitergesetzt!}
  192.  BEGIN
  193.   Basis^[(ScreenX*Pred(y) +Pred(x))]:=ch
  194.  END;
  195.  
  196.  FUNCTION GetCharXY(x,y:BYTE):WORD;
  197.  { in: (x,y) = Bildschirmposition des auszulesenden Zeichens}
  198.  {     Basis = Zeiger auf Pos. (0,0) des Schirms}
  199.  {     ScreenX = horizontale Auflösung des Bildschirms}
  200.  {     ScreenY = dto., vertikal}
  201.  {out: vom Bildschirm gelesenens Zeichen, inklusive Attribut, in}
  202.  {     der Form "Farbe SHL 8 +Ord(Zeichen)"}
  203.  BEGIN
  204.   GetCharXY:=Basis^[(ScreenX*Pred(y) +Pred(x))]
  205.  END;
  206.  
  207.  PROCEDURE OutStringXY(x,y,attr:BYTE; s:STRING);
  208.  { in: (x,y) = Bildschirmposition für auszugebendes Zeichen}
  209.  {     attr  = Attribut für Stringzeichen}
  210.  {     s = auszugebende Zeichen}
  211.  {     Basis = Zeiger auf Pos. (0,0) des Schirms}
  212.  {     ScreenX = horizontale Auflösung des Bildschirms}
  213.  {     ScreenY = dto., vertikal}
  214.  {rem: Die Cursorposition wurde durch OutStringXY() nicht weitergesetzt!}
  215.  VAR i:BYTE;
  216.      offs:WORD;
  217.  BEGIN
  218.   offs:=ScreenX*Pred(y) +Pred(x);
  219.   FOR i:=1 TO Length(s) DO
  220.    Basis^[offs +Pred(i)]:=attr SHL 8 +BYTE(s[i])
  221.  END;
  222.  
  223. {------------------------------------------------------------}
  224.  
  225.  PROCEDURE StripBlanks(VAR s:TAlles);
  226.  VAR i:BYTE;
  227.  BEGIN
  228.   FOR i:=length(s) DOWNTO 1 DO
  229.    IF s[i]=' ' THEN Delete(s,i,1)
  230.  END;
  231.  
  232.  FUNCTION min(x,y:INTEGER):INTEGER;
  233.  BEGIN
  234.   IF x<=y THEN min:=x ELSE min:=y
  235.  END;
  236.  
  237.  FUNCTION max(x,y:INTEGER):INTEGER;
  238.  BEGIN
  239.   IF x>=y THEN max:=x ELSE max:=y
  240.  END;
  241.  
  242.  FUNCTION BIOSreadKey:WORD; ASSEMBLER;
  243.  {rem: Wird benötigt, da ReadKey() keine Scancodes zurückliefert}
  244.  ASM
  245.   MOV AH,0
  246.   INT $16
  247.  END;
  248.  
  249.  FUNCTION UpString(St:STRING):STRING;
  250.  VAR i:byte;
  251.  BEGIN
  252.   FOR i:=1 TO length(st) DO
  253.    Case St[i] OF
  254.     'ä':St[i]:='Ä';
  255.     'ö':St[i]:='Ö';
  256.     'ü':St[i]:='Ü';
  257.     else St[i]:=Upcase(St[i]);
  258.    END;
  259.   UpString:=St
  260.  END;
  261.  
  262.  FUNCTION LoString(St:STRING):STRING;
  263.  VAR i:BYTE;
  264.  BEGIN
  265.   FOR i:=1 TO length(st) DO
  266.    Case St[i] OF
  267.     'Ä':St[i]:='a';
  268.     'Ö':St[i]:='ö';
  269.     'Ü':St[i]:='ü';
  270.     'A'..'Z':St[i]:=CHAR(BYTE(St[i]) OR $20);
  271.    END;
  272.   LoString:=St
  273.  END;
  274.  
  275.  FUNCTION Festplatten_im_System:String;
  276.  {in : - }
  277.  {out: String mit Namen der angeschlossenen}
  278.  {     Festplatten, z.B.: 'CD'             }
  279.  VAR Laufwerk,Id_Byte,Code:Byte;
  280.      s:String;
  281.  BEGIN
  282.   s:='';
  283.   Laufwerk:=3;
  284.   REPEAT
  285.   INLINE(
  286.     $8A/$56/<Laufwerk/ { MOV  DL,[Laufwerk]}
  287.     $1E/               { PUSH DS           }
  288.     $B4/$1C/           { MOV  AH,1C        }
  289.     $CD/$21/           { INT  21           }
  290.     $1E/               { PUSH DS           }
  291.     $07/               { POP  ES           }
  292.     $1F/               { POP  DS           }
  293.     $26/               { ES:               }
  294.     $8A/$17/           { MOV  DL,[BX]      }
  295.     $88/$56/<ID_Byte/  { MOV  [ID_Byte],DL }
  296.     $88/$46/<Code      { MOV  [Code],AL    }
  297.     );
  298.    IF (Code<>255) and (ID_Byte=$F8)
  299.     THEN s:=s+chr(64+Laufwerk);
  300.    INC(Laufwerk);
  301.   UNTIL (Code=255) or (Laufwerk>26);
  302.   Festplatten_im_System:=s;
  303.  END;
  304.  
  305.  
  306.  PROCEDURE Rahmen(x1,y1,x2,y2:byte);
  307.  VAR i:byte;
  308.  BEGIN
  309.   OutCharXY(x1,y1,TextAttr SHL 8 +218);
  310.   FOR i:=x1+1 TO x2-1 DO OutCharXY(i,y1,TextAttr SHL 8 +196);
  311.   OutCharXY(x2,y1,TextAttr SHL 8 +191);
  312.   FOR i:=y1+1 TO y2-1 DO
  313.    BEGIN
  314.     OutCharXY(x1,i,TextAttr SHL 8 +179);
  315.     OutCharXY(x2,i,TextAttr SHL 8 +179);
  316.    END;
  317.   OutCharXY(x1,y2,TextAttr SHL 8 +192);
  318.   FOR i:=x1+1 TO x2-1 DO OutCharXY(i,y2,TextAttr SHL 8 +196);
  319.   OutCharXY(x2,y2,TextAttr SHL 8 +217)
  320.  END;
  321.  
  322.  PROCEDURE DelList(VAR list:PDateiName);
  323.  VAR p:PDateiName;
  324.  BEGIN
  325.   WHILE list<>NIL DO
  326.    BEGIN
  327.     p:=list;
  328.     list:=list^.next;
  329.     dispose(p)
  330.    END;
  331.  END;
  332.  
  333.  FUNCTION LeadingChars(t:WORD; ch:CHAR; n:BYTE):STRING;
  334.  {Wandelt t in STRING und füllt ihn vorn auf n Stellen mit ch auf}
  335.  VAR s:STRING;
  336.      i:BYTE;
  337.  BEGIN
  338.   STR(t,s);
  339.   FOR i:=succ(length(s)) TO n DO insert(ch,s,1);
  340.   LeadingChars:=s
  341.  END;
  342.  
  343. {$IFDEF test}
  344.  PROCEDURE WriteEntry(x,y:BYTE; p:DateiName);
  345.  VAR t:DateTime;
  346.  BEGIN
  347.   GotoXY(x,y);
  348.   WITH p DO
  349.    BEGIN
  350.     WRITE(ganz,'│');
  351.     CASE art OF
  352.      Datei: IF size<1E9
  353.              THEN WRITE(size:8,'│') {paßt ins Feld}
  354.              ELSE WRITE(LeadingChars((size DIV 1024),' ',7)+'K','│');
  355.      Laufwerk:WRITE(#16+' DISK '+#17,'│');
  356.      Verzeichnis:IF pos('..',Vorname)=0
  357.                   THEN WRITE(#16+'SUBDIR'+#17,'│')
  358.                   ELSE WRITE(#16+'UP-DIR'+#17,'│')
  359.     END;
  360.     IF art<>Laufwerk
  361.      THEN BEGIN
  362.            UnpackTime(Date,t);
  363.            WRITE(LeadingChars(t.day,'0',2),'.',
  364.                  LeadingChars(t.month,'0',2),'.',
  365.                  LeadingChars(t.year,'0',4),
  366.                  '│',
  367.                  LeadingChars(t.hour,'0',2),':',
  368.                  LeadingChars(t.min,'0',2));
  369.           END
  370.      ELSE WRITE('          ','│','     ');
  371.    END;
  372.  END;
  373.  
  374.  PROCEDURE WriteList(list:PDateiName);
  375.  VAR y:BYTE;
  376.  BEGIN
  377.   y:=1;
  378.   WHILE list<>NIL DO
  379.    BEGIN
  380.     WriteEntry(1,y,list^);
  381.     list:=list^.next;
  382.     inc(y); IF y>25 THEN y:=1;
  383.    END;
  384.  END;
  385. {$ENDIF}
  386.  
  387. FUNCTION NameCompare(Muster,Name:TAlles):BOOLEAN;
  388. { in: Muster = evtl. mit Wildcards "*","?" behaftetes Vergleichsmuster}
  389. {     Name   = mit "Muster" zu vergleichender Name}
  390. {out: TRUE/FALSE, wenn Muster auf Name zutrifft/nicht zutrifft}
  391. {rem: o Einzuhaltende Konventionen: Hat die Datei keine Extension, so muß}
  392. {       ihr Name mit abschließendem Punkt eingeben werden "sowiedas.", um}
  393. {       per Suchmaske "*." gefunden werden zu können!}
  394. {     o "*" entspricht "*.*"}
  395.  
  396.   FUNCTION SimpleCompare(Muster,Name:TAlles):BOOLEAN;
  397.   {rem: Funktionell wie ComplexCompare(), aber nur für Muster, die die}
  398.   {     Wildcard "*" nicht enthalten}
  399.   VAR i:BYTE;
  400.       gleich:BOOLEAN;
  401.   BEGIN
  402.    IF Length(Muster)<>Length(Name)
  403.     THEN SimpleCompare:=FALSE
  404.     ELSE BEGIN
  405.           gleich:=TRUE;
  406.           i:=Length(Muster);
  407.       WHILE (i>0) AND gleich DO
  408.            BEGIN
  409.             gleich:=gleich AND
  410.              ( (Muster[i]='?') OR (Muster[i]=Name[i]) );
  411.             DEC(i)
  412.            END;
  413.           SimpleCompare:=gleich
  414.          END;
  415.   END;
  416.  
  417.   FUNCTION ComplexCompare(Muster,Name:TAlles):BOOLEAN;
  418.   {rem: Funktionell wie NameCompare(), erwartet aber "*.*" bereits }
  419.   {     konvertiert in "*" und "**"->"*"}
  420.   VAR i,p,anzahl:BYTE;
  421.       j:INTEGER;
  422.       found:BOOLEAN;
  423.       ch:CHAR;
  424.   BEGIN
  425.    IF Muster='*'  {erster IF-Zweig ist Abk., könnte auch weggelassen werden}
  426.     THEN ComplexCompare:=TRUE
  427.     ELSE BEGIN
  428.           p:=POS('*',Muster);
  429.           IF p=0
  430.            THEN ComplexCompare:=SimpleCompare(Muster,Name)
  431.        ELSE BEGIN
  432.                  IF NOT SimpleCompare(Copy(Muster,1,p-1),Copy(Name,1,p-1))
  433.                   THEN ComplexCompare:=FALSE
  434.           ELSE BEGIN
  435.                         delete(Muster,1,p-1); {1.Zeichen ist jetzt "*"}
  436.                         delete(Name,1,p-1);
  437.                         p:=Length(Muster);
  438.                         IF p=1
  439.                          THEN ComplexCompare:=TRUE  {Muster='*'}
  440.              ELSE BEGIN
  441.                                WHILE Muster[p]<>'*' DO DEC(p); {letztes "*" suchen}
  442.                                anzahl:=Length(Muster)-p;
  443.                                IF NOT SimpleCompare(
  444.                                        Copy(Muster,p+1,anzahl),
  445.                                        Copy(Name,Length(Name)-anzahl+1,anzahl))
  446.                                 THEN ComplexCompare:=FALSE
  447.                 ELSE BEGIN
  448.                                       delete(Muster,p+1,anzahl); {letztes Zeichen='*'}
  449.                                       delete(Name,Length(Name)-anzahl+1,anzahl);
  450.                                       {Hier: 1.& letztes Zeichen von Muster='*'}
  451.                                       IF Name=''
  452.                                        THEN ComplexCompare:=Muster='*'
  453.                        ELSE BEGIN {auf Folgezeichen von '*' synchronisieren}
  454.                                              delete(Muster,1,1); {'*' löschen}
  455.                                              anzahl:=0; p:=0;
  456.                                              FOR i:=Length(Muster) DOWNTO 1 DO
  457.                                               IF Muster[i]='?' THEN INC(anzahl)
  458.                                               ELSE IF Muster[i]<>'*' THEN p:=i;
  459.                                              {p=Position des 1.Zeichens<>'?','*'}
  460.                                              {anzahl=#'?' in Muster}
  461.                                              IF p=0  {besteht Muster nur aus Wildcards?}
  462.                                               THEN ComplexCompare:=Length(Name)>anzahl
  463.                           ELSE BEGIN {nein, synchronisieren}
  464.                                                     found:=FALSE;
  465.                                                     ch:=Muster[p];
  466.                                                     WHILE (NOT found) AND
  467.                                                       (POS(ch,Name)>0) DO
  468.                              BEGIN
  469.                                                       j:=POS(ch,Name)-p+1;
  470.                                                       IF j<1 THEN j:=1;
  471.                                                       found:=ComplexCompare(Muster,Copy(Name,j,255));
  472.                                                       delete(Name,1,POS(ch,Name))
  473.                                                      END;
  474.                                                     ComplexCompare:=found
  475.                                                    END;
  476.                                             END;
  477.                                      END;
  478.                               END;
  479.                        END;
  480.                 END;
  481.         END;
  482.   END;
  483.  
  484. BEGIN {of NameCompare}
  485.  WHILE POS('**',Muster)>0 DO delete(Muster,POS('**',Muster),1);
  486.  IF Muster='*.*' THEN Muster:='*';
  487.  NameCompare:=ComplexCompare(Muster,Name)
  488. END;
  489.  
  490.  PROCEDURE Auswahl(x,y,MaxZeilen:BYTE; Header:STRING;
  491.                    list:PDateiname; listlen:WORD;
  492.                    nur_eins:BOOLEAN; VAR last,sel:PDateiname;
  493.                    VAR CursSelected:BOOLEAN);
  494.  { in: Maxzeilen = zu verwendende Zeilenzahl}
  495.  {     x,y = Position für li. obere Ecke der Auswahlbox}
  496.  {     Header = Headerstring für Box, i.d.R. der aktuelle Pfad, aber an}
  497.  {            sich ein beliebiger String}
  498.  {     list = Liste der Einträge, aus denen ausgewählt werden soll}
  499.  {     listlen = Länge dieser Liste}
  500.  {     nur_eins = Flag für: es darf nur 1 Datei|mehrere Dateien gewählt werden}
  501.  {     sel  = NIL (ansonsten wird evtl. Liste gelöscht)}
  502.  {     ScreenX,ScreenY = Bildschirmweite, -höhe}
  503.  {     SelUnsel = Vorgabe für Suchmaske bei "+","-"}
  504.  {out: last = Zeiger auf letzten Eintrag, auf dem der Cursor stand}
  505.  {     sel  = Liste der selektierten Einträge}
  506.  {     CursSelected = TRUE, wenn der Eintrag unter dem Cursor bereits in }
  507.  {      der Selektionsliste steht, also später nicht noch gesondert be-  }
  508.  {      trachtet werden muß. Diese Information ist nur für nur_eins=FALSE}
  509.  {      sinnvoll!}
  510.  {     SelUnsel = evtl. neue Suchmaske für nächstes "+","-"}
  511.  {rem: ab x müssen 40 Spalten zur Verfügung stehen,}
  512.  {     ab y müssen MaxZeilen zur Verfügung stehen, }
  513.  {     MaxZeilen>6}
  514.  {     SelUnsel dient als "Gedächtnis" von evtl. Suchmasken und ist deshalb}
  515.  {     global definiert und vorbesetzt}
  516.  {     Bildschirm wird *nicht* gerettet/gelöscht!}
  517.  {     Dateinamen werden in Kleinschrift zurückgegeben, Verzeichnisse und}
  518.  {     Laufwerke in Großschrift}
  519.  
  520.  {     Für nur_eins=TRUE ist der Rückgabewert von "sel" nicht definiert; }
  521.  {     stattdessen muß "last" ausgewertet werden: ist last=NIL, so wurde }
  522.  {     die Selektion per ESC abgebrochen, ansonsten ist last^ dasjenige  }
  523.  {     File, auf dem der Benutzer RETURN drückte.}
  524.  {     Für nur_eins=FALSE gilt Analoges, nur daß "sel" hier zusätzlich   }
  525.  {     eine Liste aller Files des zuletzt gezeigten Verzeichnisses dar-  }
  526.  {     stellt, die vom Benutzer per INSERT selektiert wurden. Achtung:   }
  527.  {     Das File, auf dem der Benutzer zuletzt RETURN drückte, wurde da-  }
  528.  {     durch nicht automatisch in die Selektionsliste "sel" mitaufgenom- }
  529.  {     men (höchstens, es wurde bereits vorher ebenfalls mit INSERT aus- }
  530.  {     gewählt), d.h.: *wenn* es ebenfalls mitverwendet werden soll, so  }
  531.  {     muß der "last"-Eintrag zusätzlich ausgewertet werden; dabei ist zu}
  532.  {     beachten, daß zur Vermeidung evtl. doppelten Auftretens des Cur-  }
  533.  {     soreintrages (1x in last^, 1x in sel-Liste) "CursSelected" ver-   }
  534.  {     wendet werden kann!}
  535.  {     ACHTUNG: Die Ausgaben dieser Prozedur sind mit Blanks aufgefüllt! }
  536.  {     (Z.B.: "config  .sys" statt "config.sys"). Zum entfernen steht die}
  537.  {     Prozedur "StripBlanks() zur Verfügung!}
  538.  LABEL break1,quit_CASE;
  539.  TYPE TBild=ARRAY[1..132,1..60] OF WORD; {sollte für alle Textmodi reichen}
  540.  CONST width=40;
  541.        CNormalText=White;
  542.        BNormalText=Blue;
  543.        BCursor=Cyan;
  544.        CInfoText=Yellow;
  545.        CSelectedText=Yellow;
  546.        MaxEntries=1000; {max. Anzahl an Files/Directory}
  547.  VAR oldAttr,Textzeilen,letzte,oldx,oldy:BYTE;
  548.      i,erstegezeigte,cursorzeile,anzselected:WORD;
  549.      sizeselected:LONGINT;
  550.      speedaccess:ARRAY[0..MaxEntries] OF PDateiName; {Schnellzugriff auf Daten}
  551.      selected:ARRAY[0..MaxEntries] OF Boolean;
  552.      p,temp:PDateiName;
  553.      oldcurs,wahl:WORD;
  554.      ch:CHAR;
  555.      flag:BOOLEAN;
  556.  
  557.      s:TAlles;
  558.      attr,BoxX,BoxY,bx,by:BYTE;
  559.      Bild:^TBild; {Speicher für Bildschirmspeicher}
  560.  
  561.   (* nicht mehr nötig, da kein WRITELN() mehr benutzt!
  562.   PROCEDURE HideCursor; ASSEMBLER;
  563.   ASM
  564.    PUSH DS
  565.    PUSH BP
  566.  
  567.    MOV AH,$F
  568.    INT $10   {danach: BH=Display page }
  569.  
  570.    mov ah,3
  571.    int $10
  572.    mov dx,$FFFF
  573.    mov ah,2
  574.    xor bh,bh
  575.    int $10     {set it to pos. 255,255 -> invisible}
  576.  
  577.    POP BP
  578.    POP DS
  579.   END;
  580.  
  581.   PROCEDURE ShowCursor;
  582.   VAR dummy:WORD;
  583.   BEGIN
  584.    dummy:=oldcurs;
  585.    ASM
  586.     MOV CX,dummy
  587.     PUSH DS
  588.     PUSH BP
  589.  
  590.     MOV AH,$F
  591.     INT $10   {danach: BH=Display page }
  592.  
  593.     mov ah,2
  594.     mov DX,CX
  595.     int $10     {set it to page 0 -> visible}
  596.  
  597.     POP BP
  598.     POP DS
  599.    END;
  600.   END;
  601.   *)
  602.  
  603.   PROCEDURE WriteLine(Zeile:BYTE; p:PDateiName; sel:BOOLEAN);
  604.   { in: (x+1,Zeile) = Position für Textausgabe}
  605.   {     p = Zeiger auf auszugebenden Record }
  606.   {     sel = TRUE|FALSE für: Datei ist selektiert/nicht sel.}
  607.   VAR t:DateTime;
  608.       s:STRING[8];
  609.   BEGIN
  610.    IF sel
  611.     THEN TextColor(CSelectedText)
  612.     ELSE TextColor(CNormalText);
  613.    WITH p^ DO
  614.     BEGIN
  615.      OutStringXY(x+1,Zeile,TextAttr,ganz+'│');
  616.      CASE art OF
  617.       Datei: BEGIN
  618.               IF size<1E9
  619.                THEN BEGIN {paßt ins Feld}
  620.                      STR(size:8,s);
  621.                      OutStringXY(x+14,zeile,TextAttr,s+'│')
  622.                     END
  623.                ELSE OutStringXY(x+14,zeile,TextAttr,
  624.                      LeadingChars((size DIV 1024),' ',7)+'K'+'│');
  625.              END;
  626.       Laufwerk:OutStringXY(x+14,zeile,TextAttr,#16+' DISK '+#17+'│');
  627.       Verzeichnis:IF pos('..',Vorname)=0
  628.                    THEN OutStringXY(x+14,zeile,TextAttr,#16+'SUBDIR'+#17+'│')
  629.                    ELSE OutStringXY(x+14,zeile,TextAttr,#16+'UP-DIR'+#17+'│')
  630.      END;
  631.      IF art<>Laufwerk
  632.       THEN BEGIN
  633.             UnpackTime(Date,t);
  634.             OutStringXY(x+23,zeile,TextAttr,
  635.                   LeadingChars(t.day,'0',2)+'.'+
  636.                   LeadingChars(t.month,'0',2)+'.'+
  637.                   LeadingChars(t.year,'0',4)+
  638.                   '│'+
  639.                   LeadingChars(t.hour,'0',2)+':'+
  640.                   LeadingChars(t.min,'0',2));
  641.            END
  642.       ELSE OutStringXY(x+23,zeile,TextAttr,'          │     ');
  643.     END;
  644.    IF sel THEN TextColor(CNormalText)
  645.   END;
  646.  
  647.   PROCEDURE UpdateStatus;
  648.   { in: sizeselected = Größe der selektierten Dateien}
  649.   {     anzselected  = #selektierte Dateien}
  650.   {     x+1,letzte-1 = Position für Textausgabe}
  651.   VAR s:STRING[15];
  652.       t:STRING[5];
  653.   BEGIN
  654.    STR(sizeselected:8,s); STR(anzselected:5,t);
  655.    OutStringXY(x+1,letzte-1,BNormalText SHL 4 +CInfoText,
  656.     s+' bytes in'+t+' selected files');
  657.   END;
  658.  
  659.   PROCEDURE ShowCursorLine;
  660.   { in: erstegezeigte = 1. angezeigte Zeile}
  661.   {     cursorzeile   = Zeile für Cursor (absolut, nicht Bildschirm!)}
  662.   {     x+1,y+3 = Position der 1.Bildschirmzeile für Dateieneinträge}
  663.   {out: cursorzeile wurde farblich hervorgehoben}
  664.   {rem: Cursorzeile muß sichtbar sein}
  665.   VAR old:BYTE;
  666.   BEGIN
  667.    old:=TextAttr;
  668.    TextBackground(BCursor);
  669.    WriteLine(cursorzeile-erstegezeigte+y+3,SpeedAccess[cursorzeile],
  670.     selected[cursorzeile]);
  671.    (* HideCursor; *) {nicht mehr nötig, da kein WRITELN() mehr benutzt!}
  672.    TextAttr:=old
  673.   END;
  674.  
  675.   PROCEDURE DisplayList;
  676.   { in: speedaccess[0..listlen-1] = Zeiger auf Daten}
  677.   {     erstegezeigte = 1. anzuzeigende Zeile}
  678.   {     cursorzeile   = Zeile für Cursor (absolut, nicht Bildschirm!)}
  679.   {     Textzeilen    = #Zeilen, die anzuzeigen sind}
  680.   {     x+1,y+3       = Anfang für 1.Zeile}
  681.   {rem: cursorzeile muß auf Schirm sein!}
  682.   VAR i,last:WORD;
  683.   BEGIN
  684.    last:=min(listlen-1,erstegezeigte+Textzeilen-1);
  685.    FOR i:=erstegezeigte TO last DO
  686.     WriteLine(y+(i-erstegezeigte)+3,speedaccess[i],selected[i]);
  687.    FOR i:=succ(last) TO erstegezeigte+Textzeilen-1 DO
  688.     OutStringXY(x+1,y+3+i,TextAttr,'            │        │          │     │');
  689.   END;
  690.  
  691.  BEGIN
  692.   (* nicht mehr nötig, da kein WRITELN() mehr benutzt!
  693.   ASM
  694.    PUSH DS
  695.    PUSH BP
  696.  
  697.    MOV AH,$F
  698.    INT $10   {danach: BH=Display page }
  699.    mov ah,3
  700.    int $10   {Cursorposition auslesen }
  701.    POP BP
  702.    POP DS
  703.  
  704.    mov oldcurs,DX
  705.   END;
  706.   *)
  707.  
  708.   IF nur_eins
  709.    THEN Textzeilen:=MaxZeilen-4
  710.    ELSE Textzeilen:=MaxZeilen-4-2; {Platz schaffen}
  711.   letzte:=y+MaxZeilen-1;   {letzte Textzeile}
  712.   oldAttr:=TextAttr; {alte Textfarben}
  713.  
  714.   TextAttr:=BNormalText SHL 4 +CNormalText;
  715.   OutStringXY(x,y,TextAttr,'╒════════════╤════════╤══════════╤═════╕');
  716.   {Header evtl. zurechtschneiden:}
  717.   Header:=Copy(Header,Length(Header)-(width-2)+1,width-2);
  718.   OutStringXY(x+ (width-Length(Header)) SHR 1,y,TextAttr,Header);
  719.   OutStringXY(x,y+1,TextAttr,'│    '); TextColor(CInfoText);
  720.   OutStringXY(x+5,y+1,TextAttr,'Name'); TextColor(CNormalText);
  721.   OutStringXY(x+9,y+1,TextAttr,'    │  '); TextColor(CInfoText);
  722.   OutStringXY(x+16,y+1,TextAttr,'Size'); TextColor(CNormalText);
  723.   OutStringXY(x+20,y+1,TextAttr,'  │   '); TextColor(CInfoText);
  724.   OutStringXY(x+26,y+1,TextAttr,'Date'); TextColor(CNormalText);
  725.   OutStringXY(x+30,y+1,TextAttr,'   │ '); TextColor(CInfoText);
  726.   OutStringXY(x+35,y+1,TextAttr,'Time'); TextColor(CNormalText);
  727.   OutCharXY(x+39,y+1,TextAttr SHL 8 +BYTE('│'));
  728.   OutStringXY(x,y+2,TextAttr,'├────────────┼────────┼──────────┼─────┤');
  729.   FOR i:=y+3 TO letzte-3 DO
  730.    BEGIN
  731.     OutCharXY(x,i,TextAttr SHL 8 +BYTE('│'));
  732.     OutCharXY(x+Width-1,i,TextAttr SHL 8 +BYTE('│'));
  733.    END;
  734.   IF nur_eins
  735.    THEN BEGIN
  736.          OutCharXY(x,letzte-2,TextAttr SHL 8 +BYTE('│'));
  737.          OutCharXY(x+Width-1,letzte-2,TextAttr SHL 8 +BYTE('│'));
  738.         END
  739.    ELSE OutStringXY(x,letzte-2,TextAttr,
  740.          '├────────────┴────────┴──────────┴─────┤');
  741.   OutStringXY(x,letzte-1,TextAttr,
  742.    '│                                      │');
  743.   OutStringXY(x,letzte,TextAttr,
  744.    '╘══════════════════════════════════════');
  745.   OutCharXY(x+39,letzte,TextAttr SHL 8 ++ORD('╛'));
  746.  
  747.   erstegezeigte:=0; {absolut}
  748.   cursorzeile  :=0; {absolut}
  749.   anzselected  :=0; sizeselected:=0; {noch nichts selektiert}
  750.   IF NOT nur_eins THEN UpdateStatus;
  751.  
  752.   {Schnellzugriff auf Daten ermöglichen:}
  753.   FillChar(selected,SizeOf(selected),FALSE);
  754.   p:=list;
  755.   FOR i:=0 TO listlen-1 DO
  756.    BEGIN
  757.     speedaccess[i]:=p;
  758.     p:=p^.next
  759.    END;
  760.   DisplayList;
  761.   ShowCursorLine;
  762.  
  763.   {Jetzt Taste abwarten und geeignet reagieren:}
  764.   REPEAT
  765.    Wahl:=BIOSreadKey;
  766.    ch:=CHAR(Lo(Wahl)); {ASCII-Zeichen}
  767.    CASE Wahl OF
  768.     $4800: {Up}
  769.      IF cursorzeile>0
  770.       THEN BEGIN
  771.             dec(cursorzeile);
  772.             IF cursorzeile<erstegezeigte
  773.          THEN BEGIN {scrollen nötig}
  774.                    erstegezeigte:=cursorzeile;
  775.                    DisplayList;
  776.                    ShowCursorLine
  777.                   END
  778.          ELSE BEGIN {kein scrollen nötig}
  779.                    WriteLine(Succ(cursorzeile)-erstegezeigte+y+3,
  780.                              SpeedAccess[Succ(cursorzeile)],
  781.                              Selected[Succ(cursorzeile)]);
  782.                    ShowCursorLine
  783.                   END;
  784.            END;
  785.     $5000: {Down}
  786.      IF cursorzeile<Pred(listlen)
  787.       THEN BEGIN
  788.             inc(cursorzeile);
  789.             IF cursorzeile>=erstegezeigte+Textzeilen
  790.          THEN BEGIN {scrollen nötig}
  791.                    erstegezeigte:=cursorzeile-Textzeilen+1;
  792.                    DisplayList;
  793.                    ShowCursorLine
  794.                   END
  795.          ELSE BEGIN {kein scrollen nötig}
  796.                    WriteLine(Pred(cursorzeile)-erstegezeigte+y+3,
  797.                              SpeedAccess[Pred(cursorzeile)],
  798.                              Selected[Pred(cursorzeile)]);
  799.                    ShowCursorLine
  800.                   END;
  801.            END;
  802.     $4700: {Pos1}
  803.      IF cursorzeile<>0
  804.       THEN BEGIN
  805.             cursorzeile:=0;
  806.             erstegezeigte:=0;
  807.             DisplayList;
  808.             ShowCursorLine
  809.            END;
  810.     $4F00: {End}
  811.      IF cursorzeile<>Pred(listlen)
  812.       THEN BEGIN
  813.             cursorzeile:=Pred(listlen);
  814.             erstegezeigte:=max(INTEGER(cursorzeile-Textzeilen+1),0);
  815.             DisplayList;
  816.             ShowCursorLine
  817.            END;
  818.     $5200: {Insert}
  819.      IF (NOT nur_eins) AND (SpeedAccess[CursorZeile]^.Art=Datei)
  820.       THEN BEGIN
  821.             IF Selected[CursorZeile]
  822.              THEN BEGIN
  823.                    dec(anzselected);
  824.                    dec(sizeselected,SpeedAccess[CursorZeile]^.size)
  825.                   END
  826.          ELSE BEGIN
  827.                    inc(anzselected);
  828.                    inc(sizeselected,SpeedAccess[CursorZeile]^.size)
  829.                   END;
  830.             Selected[CursorZeile]:=NOT Selected[CursorZeile];
  831.             UpdateStatus;
  832.             {Jetzt noch Cursor um eins nach unten bewegen:}
  833.             IF cursorzeile<Pred(listlen)
  834.              THEN BEGIN
  835.                    inc(cursorzeile);
  836.                    IF cursorzeile>=erstegezeigte+Textzeilen
  837.                 THEN BEGIN {scrollen nötig}
  838.                           erstegezeigte:=cursorzeile-Textzeilen+1;
  839.                           DisplayList;
  840.                           ShowCursorLine
  841.                          END
  842.                 ELSE BEGIN {kein scrollen nötig}
  843.                           WriteLine(Pred(cursorzeile)-erstegezeigte+y+3,
  844.                                     SpeedAccess[Pred(cursorzeile)],
  845.                                     Selected[Pred(cursorzeile)]);
  846.                           ShowCursorLine
  847.                          END;
  848.                   END
  849.              ELSE ShowCursorLine
  850.            END;
  851.     $4900: {PgUp}
  852.      IF (max(0,INTEGER(erstegezeigte-TextZeilen))<>CursorZeile)
  853.       THEN BEGIN
  854.             erstegezeigte:=max(0,INTEGER(erstegezeigte-Textzeilen));
  855.             IF erstegezeigte=0
  856.              THEN CursorZeile:=0
  857.              ELSE CursorZeile:=max(0,INTEGER(CursorZeile-Textzeilen));
  858.             DisplayList;
  859.             ShowCursorLine
  860.            END;
  861.     $5100: {PgDn}
  862.      IF (min(Pred(listlen),erstegezeigte+TextZeilen)<>CursorZeile)
  863.       THEN BEGIN
  864.             erstegezeigte:=min(Pred(listlen)-Textzeilen+1,erstegezeigte+TextZeilen);
  865.             IF (erstegezeigte+TextZeilen)=listlen
  866.              THEN CursorZeile:=Pred(listlen)
  867.              ELSE CursorZeile:=min(Pred(listlen),CursorZeile+Textzeilen);
  868.             DisplayList;
  869.             ShowCursorLine
  870.            END;
  871.     $8400: {Ctrl-PgUp}
  872.      BEGIN
  873.       FOR i:=0 TO Pred(listlen) DO
  874.        IF POS('..',SpeedAccess[i]^.Vorname)<>0
  875.     THEN BEGIN {so tun, als hätte User auf ".." positioniert und CR gedrückt}
  876.               CursorZeile:=i;
  877.               ch:=#13;
  878.               goto quit_CASE
  879.              END;
  880.       sound(1000); delay(70); nosound  {piepsen, da im Rootverzeichnis}
  881.      END;
  882.     $4E2B: {Grey "+"}
  883.      BEGIN
  884.       BoxX:=ScreenX SHR 1 -7; BoxY:=ScreenY SHR 1;
  885.  
  886.       New(Bild);
  887.       FOR by:=BoxY-1 TO BoxY+1 DO      {Bildausschnitt retten}
  888.        FOR bx:=BoxX-1 TO BoxX+14+1 DO
  889.         Bild^[bx,by]:=GetCharXY(bx,by);
  890.  
  891.       (* ShowCursor; *) {nicht mehr nötig, da kein WRITELN() mehr benutzt!}
  892.       oldX:=WhereX; oldY:=WhereY;
  893.       GotoXY(BoxX,BoxY);
  894.       FLAG:=FALSE;
  895.       attr:=TextAttr; TextColor(Black); TextBackground(Cyan);
  896.       BoxGetString(SelUnsel,14,FLAG,'select files:');
  897.       GotoXY(oldX,oldY);
  898.       (* HideCursor; *) {nicht mehr nötig, da kein WRITELN() mehr benutzt!}
  899.       TextAttr:=attr;
  900.  
  901.       FOR by:=BoxY-1 TO BoxY+1 DO      {Bildausschnitt wiederherstellen}
  902.        FOR bx:=BoxX-1 TO BoxX+14+1 DO
  903.         OutCharXY(bx,by,Bild^[bx,by]);
  904.       Dispose(Bild);
  905.  
  906.       IF NOT FLAG
  907.        THEN BEGIN {Liste absuchen nach Muster "SelUnsel"}
  908.              SelUnsel:=Upstring(SelUnsel);
  909.              StripBlanks(SelUnsel);
  910.              FOR i:=0 TO Pred(Listlen) DO
  911.           BEGIN
  912.                s:=Upstring(SpeedAccess[i]^.ganz);
  913.                StripBlanks(s);
  914.                IF NameCompare(SelUnsel,s)
  915.                 THEN BEGIN {Match gefunden!}
  916.                       IF (NOT nur_eins) AND
  917.                          (NOT Selected[i]) AND
  918.                          (SpeedAccess[i]^.Art=Datei)
  919.                        THEN BEGIN
  920.                              inc(anzselected);
  921.                              inc(sizeselected,SpeedAccess[i]^.size);
  922.                              Selected[i]:=TRUE;
  923.                             END;
  924.                       IF nur_eins
  925.                        THEN BEGIN
  926.                              CursorZeile:=i;
  927.                              erstegezeigte:=max(INTEGER(cursorzeile-Textzeilen+1),0);
  928.                              DisplayList;
  929.                              ShowCursorLine;
  930.                              goto break1
  931.                             END;
  932.                      END
  933.               END;
  934.              IF NOT nur_eins
  935.               THEN BEGIN {gefundene farblich anzeigen}
  936.                     DisplayList;
  937.                     UpdateStatus;
  938.                     ShowCursorLine;
  939.                    END
  940.           ELSE BEGIN {kein einzelnes gefunden}
  941.                     sound(1000); delay(70); nosound
  942.                    END;
  943.              break1:;
  944.             END;
  945.  
  946.      END;
  947.     $4A2D: {Grey "-"}
  948.      BEGIN
  949.       IF (NOT nur_eins) AND (anzselected>0)
  950.        THEN BEGIN
  951.              BoxX:=ScreenX SHR 1 -7; BoxY:=ScreenY SHR 1;
  952.  
  953.              New(Bild);
  954.              FOR by:=BoxY-1 TO BoxY+1 DO      {Bildausschnitt retten}
  955.               FOR bx:=BoxX-1 TO BoxX+14+1 DO
  956.                Bild^[bx,by]:=GetCharXY(bx,by);
  957.  
  958.              (* ShowCursor; *) {nicht mehr nötig, da kein WRITELN() mehr benutzt!}
  959.              oldX:=WhereX; oldY:=WhereY;
  960.              GotoXY(BoxX,BoxY);
  961.              FLAG:=FALSE;
  962.              attr:=TextAttr; TextColor(Black); TextBackground(Cyan);
  963.              BoxGetString(SelUnsel,14,FLAG,'unselect files:');
  964.              GotoXY(oldX,oldY);
  965.              (* HideCursor; *) {nicht mehr nötig, da kein WRITELN() mehr benutzt!}
  966.              TextAttr:=attr;
  967.  
  968.              FOR by:=BoxY-1 TO BoxY+1 DO      {Bildausschnitt wiederherstellen}
  969.               FOR bx:=BoxX-1 TO BoxX+14+1 DO
  970.                OutCharXY(bx,by,Bild^[bx,by]);
  971.              Dispose(Bild);
  972.  
  973.              IF NOT FLAG
  974.               THEN BEGIN {Liste absuchen nach Muster "SelUnsel"}
  975.                     SelUnsel:=Upstring(SelUnsel);
  976.                     StripBlanks(SelUnsel);
  977.                     FOR i:=0 TO Pred(Listlen) DO
  978.                  BEGIN
  979.                       s:=Upstring(SpeedAccess[i]^.ganz);
  980.                       StripBlanks(s);
  981.                       IF Selected[i] AND
  982.                          (SpeedAccess[i]^.Art=Datei) AND
  983.                          NameCompare(SelUnsel,s)
  984.                        THEN BEGIN {Match gefunden!}
  985.                              dec(anzselected);
  986.                              dec(sizeselected,SpeedAccess[i]^.size);
  987.                              Selected[i]:=FALSE;
  988.                             END;
  989.                      END;
  990.                     DisplayList;
  991.                     UpdateStatus;
  992.                     ShowCursorLine;
  993.                    END;
  994.             END
  995.        ELSE IF anzselected=0
  996.     THEN BEGIN
  997.               sound(1000); delay(70); nosound
  998.              END;
  999.      END;
  1000.    END; {of CASE}
  1001.   quit_CASE:;
  1002.   UNTIL (ch=#13) OR (ch=#27);
  1003.  
  1004.   IF (ch=#13)
  1005.    THEN last:=SpeedAccess[CursorZeile]
  1006.    ELSE last:=NIL;
  1007.  
  1008.   IF ch<>#27
  1009.    THEN BEGIN {Auswahlliste zusammenstellen}
  1010.          DelList(sel); {evtl. alten Inhalt löschen}
  1011.          FOR i:=0 TO Pred(listlen) DO
  1012.           IF Selected[i]
  1013.        THEN BEGIN
  1014.                  new(temp);
  1015.                  temp^:=SpeedAccess[i]^;
  1016.                  IF sel=NIL
  1017.                   THEN BEGIN
  1018.                         sel:=temp;
  1019.                         p:=sel
  1020.                        END
  1021.                   ELSE BEGIN
  1022.                         p^.next:=temp;
  1023.                         p:=temp
  1024.                        END
  1025.                 END;
  1026.          IF sel<>NIL THEN p^.next:=NIL
  1027.         END;
  1028.  
  1029.   CursSelected:=Selected[CursorZeile];
  1030.  
  1031.   (* ShowCursor; *) {nicht mehr nötig, da kein WRITELN() mehr benutzt!}
  1032.   TextAttr:=oldAttr;
  1033.  END;
  1034.  
  1035.  
  1036.  
  1037.  PROCEDURE add(VAR list:PDateiName; VAR listlen:WORD;
  1038.                elem:TAlles; typ:TArt; Groesse:TSize; Datum:TDate);
  1039.  CONST Blanks12='            '; {mindestens SizeOf(TAlles) =8+1+3 Blanks}
  1040.  VAR p,temp:PDateiName;
  1041.      po:BYTE;
  1042.  BEGIN
  1043.   IF elem='.' THEN exit; {aktuelles Verzeichnis nicht speichern}
  1044.   new(temp);
  1045.   WITH temp^ DO
  1046.    BEGIN
  1047.     art:=typ;
  1048.     size:=Groesse;
  1049.     date:=Datum;
  1050.     IF typ=Laufwerk
  1051.      THEN BEGIN
  1052.            Vorname:=elem+COPY(Blanks12,1,SizeOf(TName)-Length(elem));
  1053.            Punkt:=' ';
  1054.            Nachname:='   ';
  1055.           END
  1056.      ELSE BEGIN
  1057.            IF POS('..',elem)<>0
  1058.         THEN BEGIN {Updir}
  1059.                   Vorname:=' ..'+COPY(Blanks12,1,SizeOf(TName)-length(' ..'));
  1060.                   Punkt:=' ';
  1061.                   Nachname:='   '
  1062.                  END
  1063.             ELSE BEGIN
  1064.                   po:=pos('.',elem+'.');
  1065.                   Vorname:=COPY(elem,1,pred(po))
  1066.                           +COPY(Blanks12,1,SizeOf(TName)-pred(po));
  1067.                   IF po<=length(elem)
  1068.                THEN BEGIN
  1069.                          Punkt:='.';
  1070.                          Nachname:=COPY(elem,succ(po),length(elem)-po)
  1071.                           +COPY(Blanks12,1,SizeOf(TExten)-(length(elem)-po));
  1072.                         END
  1073.                ELSE BEGIN
  1074.                          Punkt:=' '; Nachname:='   '
  1075.                         END;
  1076.                  END;
  1077.           END;
  1078.     ganz:=Vorname+Punkt+Nachname;
  1079.    END;
  1080.  
  1081.   IF list=NIL
  1082.    THEN BEGIN {neue Liste}
  1083.          list:=temp;
  1084.          temp^.next:=NIL;
  1085.          listlen:=1
  1086.         END
  1087.   ELSE IF (temp^.ganz<list^.ganz) OR (temp^.Art<list^.Art)
  1088.    THEN BEGIN {am Anfang der Liste einfügen}
  1089.          temp^.next:=list;
  1090.          list:=temp;
  1091.          inc(listlen)
  1092.         END
  1093.   ELSE  BEGIN {irgendwo zwischendrin}
  1094.          p:=list;
  1095.          {suche richtige "Sparte": Laufwerk/Verzeichnis/Typ:}
  1096.          WHILE (p^.next<>NIL) AND (temp^.Art>p^.next^.Art) DO p:=p^.next;
  1097.          {neue Sparte aufmachen oder in richtiger Sparte suchen?}
  1098.          IF (p^.next<>NIL) AND (temp^.Art=p^.next^.Art)
  1099.           THEN WHILE (p^.next<>NIL) AND (temp^.Art=p^.next^.Art)
  1100.                 AND (temp^.ganz>=p^.next^.ganz) DO p:=p^.next;
  1101.          IF (temp^.ganz<>p^.ganz) OR (temp^.Art<>p^.Art) {doppelte vermeiden}
  1102.       THEN BEGIN
  1103.                 temp^.next:=p^.next; {einfügen von temp nach p}
  1104.                 p^.next:=temp;
  1105.                 inc(listlen)
  1106.                END;
  1107.         END;
  1108.  END;
  1109.  
  1110.  PROCEDURE NormalizePath(VAR p:TPath);
  1111.  VAR i:BYTE;
  1112.  BEGIN
  1113.   FOR i:=length(p) DOWNTO 1 DO
  1114.    IF p[i]=' ' THEN Delete(p,i,1);
  1115.   IF p[length(p)]<>'\' THEN p:=p+'\'
  1116.  END;
  1117.  
  1118.  PROCEDURE MakeFileList(VAR p:TPath; typ:STRING;
  1119.                         VAR list:PDateiName; VAR listlen:WORD;
  1120.                         VAR error:BOOLEAN);
  1121.  { in: Laufwerke = String mit LW im System}
  1122.  {     p = Suchpfad zum Verzeichnis, z.B.: "C:\TURBO6\"}
  1123.  {     typ = Suchmaske(n), mit Blanks getrennt, z.B.: "*.pas *.bak"}
  1124.  {     list = NIL (ansonsten wird Liste gelöscht)}
  1125.  {out: p = evtl. normierter Pfad}
  1126.  {     list = Liste der gefundenen Dateien}
  1127.  {     listlen = Anzahl Einträge in dieser Liste}
  1128.  {     error = TRUE, falls ungewöhnlicher Fehler auftrat (Pfad ex. nicht o.ä.)}
  1129.  {             Kann i.d.R. aber ignoriert werden, da Schachtel eh nur gültige }
  1130.  {             Einträge zur Auswahl stellt!}
  1131.  VAR dirinfo:SearchRec;
  1132.      i,anzahl:word;
  1133.      temp:TAlles;
  1134.      po:BYTE;
  1135.      name:TPath;
  1136.      originalINT24h:POINTER;
  1137.  BEGIN
  1138.   GetIntVec($24,originalINT24h); {momentanen CriticalErrHandler" retten  }
  1139.   SetIntVec($24,SaveInt24);      {auf TP's "CriticalErrHandler" umstellen}
  1140.   NormalizePath(p);
  1141.   DelList(list);
  1142.   listlen:=0;
  1143.   IF typ='' THEN typ:='*.*';
  1144.   IF (length(p)=0) OR (p[length(p)]<>'\') THEN p:=p+'\';
  1145.   IF typ[length(typ)]<>' ' THEN typ:=typ+' ';
  1146.   {Dateien suchen:}
  1147.   WHILE typ>'' DO
  1148.    BEGIN
  1149.     po:=pos(' ',typ);
  1150.     name:=p+copy(typ,1,pred(po)); delete(typ,1,po);
  1151.     findfirst(Name,Archive OR SysFile OR Hidden OR Readonly,dirinfo);
  1152.     WHILE (doserror=0) DO
  1153.      BEGIN
  1154.       IF (dirinfo.attr AND (VolumeID OR Directory))=0
  1155.        THEN add(list,listlen,LoString(dirinfo.name),Datei,dirinfo.size,dirinfo.time);
  1156.       FindNext(dirinfo)
  1157.      END;
  1158.     error:=NOT (doserror in [0,2,18]); {ok|keine Datei gefunden|alle durch}
  1159.    END;
  1160.  
  1161.   {Nun Verzeichnisse eintragen:}
  1162.   name:=p+'*.*';
  1163.   findfirst(Name,Directory,dirinfo);
  1164.   WHILE (doserror=0) DO
  1165.    BEGIN
  1166.     IF (dirinfo.attr AND Directory)<>0
  1167.      THEN add(list,listlen,UpString(dirinfo.name),Verzeichnis,dirinfo.size,dirinfo.time);
  1168.     FindNext(dirinfo)
  1169.    END;
  1170.   error:=error OR NOT (doserror in [0,2,18]);
  1171.  
  1172.   {Jetzt noch evtl. Laufwerke mitaufnehmen:}
  1173.   IF length(p)<=3
  1174.    THEN BEGIN {Rootverzeichnis, deshalb Laufwerke mitaufnehmen}
  1175.          FOR i:=1 TO length(Laufwerke)
  1176.           DO add(list,listlen,' '+Laufwerke[i]+':',Laufwerk,0,0);
  1177.         END
  1178.    ELSE add(list,listlen,' '+'..',Verzeichnis,0,0); {ansonsten Updir mitaufnehmen}
  1179.   SetIntVec($24,originalINT24h);
  1180.  END;
  1181.  
  1182.  FUNCTION ChooseSingleFile(xpos,ypos,max_zeilen:BYTE;
  1183.                            Pf:TPath; typ:STRING; VAR error:BOOLEAN):TPath;
  1184.  { in: xpos,ypos =li. obere Ecke der Auswahlbox}
  1185.  {     max_zeilen=Zeilen für Auswahlbox}
  1186.  {     Pf  =Anfangsverzeichnis für Suche, z.B.: "C:\DOS\"}
  1187.  {     typ =Filemaske(n), durch Blank getrennt, z.B.: "*.BAT *.PAS"}
  1188.  {     Laufwerke = Disks im System, z.B.: 'ABC'}
  1189.  {out: Name des selektierten Files oder '' für keines (=Abbruch per ESC)}
  1190.  {     error = TRUE, falls ungewöhnlicher Dos-Fehler auftrat}
  1191.  {             Kann i.d.R. aber ignoriert werden, da Schachtel eh nur gültige }
  1192.  {             Einträge zur Auswahl stellt!}
  1193.  {rem: ab xpos müssen 40 Spalten zur Verfügung stehen,}
  1194.  {     ab ypos müssen MaxZeilen zur Verfügung stehen, }
  1195.  {     Max_Zeilen>6}
  1196.  {     Bildschirm wird *nicht* gerettet/gelöscht!}
  1197.  {     Es wird nur der *Name* zurückgegeben, keine zusätzlichen Angaben wie}
  1198.  {     Größe, Datum, etc. Dazu müßte man den ganzen Record "letztes" (s.u.)}
  1199.  {     zurückgeben!}
  1200.  LABEL quit;
  1201.  VAR liste,letztes,gewaehlte:PDateiName;
  1202.      listlen:WORD;
  1203.      p:BYTE;
  1204.      CursInList:BOOLEAN;
  1205.      Pfad:TPath;
  1206.  BEGIN
  1207.   liste:=NIL; letztes:=NIL; gewaehlte:=NIL;
  1208.   Pfad:=Pf; {MakeFileListe() will VAR-Typ!}
  1209.   REPEAT
  1210.    MakeFileList(Pfad, typ, liste, listlen,error);
  1211.    Auswahl(xpos,ypos,max_zeilen,Pfad+typ,liste,listlen,TRUE,letztes,gewaehlte,CursInList);
  1212.    (*
  1213.    IF error
  1214.     THEN BEGIN {bei Fehler: Schnellausstieg}
  1215.           ChooseSingleFile:='';
  1216.           goto quit
  1217.          END;
  1218.    *)
  1219.    IF letztes<>NIL
  1220.     THEN BEGIN
  1221.           CASE letztes^.Art OF
  1222.            Laufwerk:Pfad:=letztes^.ganz;
  1223.            Verzeichnis:
  1224.             IF POS('..',letztes^.Vorname)=0
  1225.          THEN BEGIN {runter im Verzeichnispfad}
  1226.                    IF Pfad[length(Pfad)]<>'\' THEN Pfad:=Pfad+'\';
  1227.                    Pfad:=Pfad+letztes^.ganz
  1228.                   END
  1229.          ELSE BEGIN {hoch im Verzeichnispfad}
  1230.                    IF Pfad[length(Pfad)]='\'
  1231.                     THEN Delete(Pfad,length(Pfad),1);
  1232.                    p:=length(Pfad);
  1233.                    WHILE (Pfad[p]<>'\') AND (p>0) DO dec(p);
  1234.                    IF p=0
  1235.                     THEN write(#7)  {sind schon auf der Root}
  1236.                     ELSE Delete(Pfad,succ(p),length(Pfad)-p)
  1237.                   END;
  1238.           END; {of CASE}
  1239.          END;
  1240.   UNTIL (letztes=NIL) OR (letztes^.Art=Datei);
  1241.  
  1242.   IF letztes=NIL
  1243.    THEN ChooseSingleFile:=''
  1244.    ELSE BEGIN
  1245.          StripBlanks(letztes^.ganz);
  1246.          ChooseSingleFile:=Pfad+letztes^.ganz;
  1247.         END;
  1248.  
  1249.  quit:;
  1250.   DelList(Liste);
  1251.   DelList(gewaehlte); {nur der Ordnung halber, ist eh leer}
  1252.  END;
  1253.  
  1254.  FUNCTION ChooseMultipleFiles(xpos,ypos,max_zeilen:BYTE;
  1255.                               VAR Pfad:TPath; typ:STRING;
  1256.                               VAR error:BOOLEAN):PDateiname;
  1257.  { in: xpos,ypos =li. obere Ecke der Auswahlbox}
  1258.  {     max_zeilen=Zeilen für Auswahlbox}
  1259.  {     Pf  =Anfangsverzeichnis für Suche, z.B.: "C:\DOS\"}
  1260.  {     typ =Filemaske(n), durch Blank getrennt, z.B.: "*.BAT *.PAS"}
  1261.  {     Laufwerke = Disks im System, z.B.: 'ABC'}
  1262.  {out: Zeiger auf selektierte Files oder NIL für keine (=Abbruch per ESC)}
  1263.  {     Pfad = Pfadname zu den selektierten Dateien}
  1264.  {     error = TRUE, falls ungewöhnlicher Dos-Fehler auftrat}
  1265.  {             Kann i.d.R. aber ignoriert werden, da Schachtel eh nur gültige }
  1266.  {             Einträge zur Auswahl stellt!}
  1267.  {rem: ab xpos müssen 40 Spalten zur Verfügung stehen,}
  1268.  {     ab ypos müssen MaxZeilen zur Verfügung stehen, }
  1269.  {     Max_Zeilen>6}
  1270.  {     Bildschirm wird *nicht* gerettet/gelöscht!}
  1271.  {     Die Namen der selektierten Dateien wurden von überflüssigen Blanks}
  1272.  {     befreit}
  1273.  LABEL quit;
  1274.  VAR liste,letztes,gewaehlte:PDateiName;
  1275.      listlen:WORD;
  1276.      p:BYTE;
  1277.      CursInList:BOOLEAN;
  1278.  BEGIN
  1279.   liste:=NIL; letztes:=NIL; gewaehlte:=NIL;
  1280.   REPEAT
  1281.    MakeFileList(Pfad, typ, liste, listlen, error);
  1282.    Auswahl(xpos,ypos,max_zeilen,Pfad+typ,liste,listlen,FALSE,letztes,gewaehlte,CursInList);
  1283.    (*
  1284.    IF error
  1285.     THEN BEGIN {bei Fehler: Schnellausstieg}
  1286.           ChooseMultipleFiles:=NIL;
  1287.           goto quit
  1288.          END;
  1289.    *)
  1290.    IF letztes<>NIL
  1291.     THEN BEGIN
  1292.           CASE letztes^.Art OF
  1293.            Laufwerk:Pfad:=letztes^.ganz;
  1294.            Verzeichnis:
  1295.             IF POS('..',letztes^.Vorname)=0
  1296.          THEN BEGIN {runter im Verzeichnispfad}
  1297.                    IF Pfad[length(Pfad)]<>'\' THEN Pfad:=Pfad+'\';
  1298.                    Pfad:=Pfad+letztes^.ganz
  1299.                   END
  1300.          ELSE BEGIN {hoch im Verzeichnispfad}
  1301.                    IF Pfad[length(Pfad)]='\'
  1302.                     THEN Delete(Pfad,length(Pfad),1);
  1303.                    p:=length(Pfad);
  1304.                    WHILE (Pfad[p]<>'\') AND (p>0) DO dec(p);
  1305.                    IF p=0
  1306.                     THEN write(#7)  {sind schon auf der Root}
  1307.                     ELSE Delete(Pfad,succ(p),length(Pfad)-p)
  1308.                   END;
  1309.           END; {of CASE}
  1310.          END;
  1311.   UNTIL (letztes=NIL) OR (letztes^.Art=Datei);
  1312.  
  1313.   IF letztes=NIL
  1314.    THEN ChooseMultipleFiles:=NIL  {Abbruch per ESC}
  1315.    ELSE BEGIN
  1316.          ChooseMultipleFiles:=gewaehlte;
  1317.          WHILE gewaehlte<>NIL DO
  1318.           BEGIN
  1319.            StripBlanks(gewaehlte^.ganz);
  1320.            gewaehlte:=gewaehlte^.next
  1321.           END
  1322.         END;
  1323.  
  1324.  quit:;
  1325.   DelList(Liste);
  1326.  END;
  1327.  
  1328. {$IFDEF test}
  1329. VAR liste,letztes,gewaehlte:PDateiName;
  1330.     listlen:WORD;
  1331.     Pfad:TPath;
  1332.     error:BOOLEAN;
  1333. {$ENDIF}
  1334. begin
  1335.  Laufwerke:='';
  1336.  Laufwerke:='AB'+Festplatten_im_System;
  1337.  DetectXYresolution(ScreenX,ScreenY);
  1338.  Basis:=BaseAddress;
  1339.  
  1340. {$IFDEF test}
  1341.  clrscr;
  1342.  WRITELN(ChooseSingleFile(41,1,ScreenY,'C:\','*.EXE *.COM *.BAT',error));
  1343.  WRITELN('(Fehler: ',error,')');
  1344.  READLN;
  1345.  ClrScr;
  1346.  Pfad:='C:\';
  1347.  liste:=ChooseMultipleFiles(5,1,ScreenY,Pfad,'*.EXE *.COM *.BAT',error);
  1348.  IF liste<>NIL
  1349.   THEN BEGIN
  1350.         WRITELN('Pfad: ',Pfad);
  1351.         WriteList(liste)
  1352.        END;
  1353.  WRITELN; WRITELN('(Fehler: ',error,')');
  1354.  DelList(liste);
  1355. {$ENDIF}
  1356. end.
  1357.